structure MipsFrame : FRAME =
struct
    structure E = ErrorMsg
    structure I = Assem
    structure M = Temp
    structure MB = M.Table
    structure R = Tree
    structure S = Symbol
    structure U = UnparseAbsyn

    type register = string

    val mainLabel = M.namedlabel "tigermain"

    fun makeReg (s, n) = ("$" ^ s ^ (Int.toString n), M.newtemp ())

    fun makeRegs (s, n) = if (0=n)
			  then [makeReg (s, 0)]
			  else (makeReg (s, n))::makeRegs (s, n-1)

    fun regName (s, _) = s
    fun regTemp (_, t) = t

    val FP = M.newtemp ()
    val FPreg = ("$fp", FP)
    
    val RA = M.newtemp ()
    val RAreg = ("$ra", RA)

    val RV = M.newtemp ()
    val RVreg = ("$v0", RV)

    val RV' = M.newtemp ()
    val RVreg' = ("$v1", RV')

    val SP = M.newtemp ()
    val SPreg = ("$sp", SP)
		
    val ZERO = M.newtemp ()
    val ZEROreg = ("$zero", ZERO)

    val specialregs = [ ZEROreg, RAreg, SPreg, FPreg, RVreg ]

    val argregs = rev (makeRegs ("a", 3))
    val args = map regTemp argregs

    val calleesaveregs = rev (makeRegs ("s", 7))
    val calleesaves = map regTemp calleesaveregs

    val callersaveregs = RVreg' :: (rev (makeRegs ("t", 9)))
    val callersaves = map regTemp callersaveregs
		      
    val regs = (calleesaveregs @ callersaveregs @ argregs @ specialregs)
    val registers = map regName regs

    val calldefs = [RA, RV]@callersaves

    val tempMap = foldr (fn ((s, m), t) => MB.enter (t, m, s))
			MB.empty
			regs
		  
    fun tempName t = case (MB.look (tempMap, t))
		      of NONE => M.makestring t
		       | SOME s => s

    datatype access = InFrame of int
		    | InReg of M.temp

    (*
     * The first 4 non-escaping parameters are passed in registers, with remaining ones passed on the stack
     *
     * The stack layout is
     *
     *  outgoing args   spill   -vars-   -------registers------   ---incoming args---   ... older frames ...   | --tigermain---
     *                | temps ; locals ; callee-saves ; ra ; fp ; parm ... parm slink | ....................     temps ; locals
     *                ^                                                               ^ 
     *                SP                                                             FP
     *  lower addresses ...................................................................................... higher addresses
     *)

    type frame = { name : M.label
		 , formals : access list
		 , size : int ref
		 , moves : R.stm (* moves to get InReg args into the argument temporaries $a0 -- $a3 *)
		 , saves : R.exp list (* pre-allocated memory locations for saving caller-save registers *) }

    val wordSize = 4

    fun formals {name, formals, size, moves, saves} = formals
	
    fun name    {name, formals, size, moves, saves} = name

    fun size    {name, formals, size, moves, saves} = !size
	
    fun moves   {name, formals, size, moves, saves} = moves

    fun postdec r = let val n = !r
		    in ( r := n - wordSize
		       ; n )
		    end
		    
    fun allocLocal {name, formals, size, moves, saves} true  = InFrame (postdec size)
      | allocLocal _                                   false = InReg (M.newtemp ())
			     
    fun externalCall (s, args) = R.CALL (R.NAME (M.namedlabel ("_" ^ s)),
					 args)

    (* yields an R.MEM or R.TEMP which can be used as an l-value or an r-value *)
    fun exp (InFrame k) fp = R.MEM (R.BINOP (R.PLUS, fp, (R.CONST k)))
      | exp (InReg r) _ = R.TEMP r

    fun staticLink {name,formals=[],size,moves,saves}                = E.impossible "NO STATIC LINK"
      | staticLink {name,formals=(sl::realFormals),size,moves,saves} = sl

    fun newFrame {name, formals} = let fun placeFormal (_,     (sz, [],          formals, stm)) = (sz-wordSize, [], (InFrame sz)::formals,                                  stm)
					 | placeFormal (true,  (sz, rs,          formals, stm)) = (sz-wordSize, rs, (InFrame sz)::formals,                                  stm)
					 | placeFormal (false, (sz, ((_,r)::rs), formals, stm)) = let val tmp = M.newtemp ()
												  in (sz,       rs, (InReg tmp) ::formals, (R.MOVE (R.TEMP tmp, R.TEMP r))::stm)
												  end
				   in let val (sz, _, formals, stm) = foldr placeFormal (0, argregs, [], []) formals
				      in let val (sz, saveExps) = if name = mainLabel
								  then (sz, [])
								  else foldr (fn (_, (sz, exps)) => (sz-wordSize,
												     (exp (InFrame sz) (R.TEMP FP))::exps))
								             (sz, [])
									     callersaves
					 in { name    = name
					    , formals = formals
					    , size    = ref sz
					    , moves   = R.seq stm
					    , saves   = saveExps }
					 end
				      end
				   end
				   
    fun formalString (InFrame n) = (Int.toString n) ^ "(fp)"
      | formalString (InReg t)   = M.makestring t

    fun  frameStats {name, formals, size, moves, saves} = "#FRAME " ^ S.name name
							  ^ "(" ^ U.commaSep (map formalString formals)
							  ^ ") of size " ^ Int.toString (!size) ^ "\n"

    fun procEntryExit1 (frame as {name,formals,size,moves,saves}, body) = if name = mainLabel
									  then body
									  else foldr (fn (r, stm) => let val place = exp (allocLocal frame true) (R.TEMP FP)
													 val rtemp = R.TEMP r
												     in R.seq [ R.MOVE (place, rtemp),
														stm,
														R.MOVE (rtemp, place)   ]
												     end)
									       (R.SEQ (moves, body))
									       (RA :: calleesaves)

    fun procEntryExit2 ({name, formals, size, moves,saves}, body) = if name = mainLabel
								    then body
								    else (I.OPER { assem = "#SRC: def: $zero, $ra, $sp, $fp, $s0--$s7, $a0--$a4\n",
										   src=[],
										   dst=[ZERO, RA, SP, FP]@calleesaves@args,
										   jump=NONE })
									 :: body
									 @ [I.OPER { assem = "#SINK: use: $zero, $ra, $sp, $fp, $s0--s7, $v0\n",
										     src=[ZERO, RA, SP, FP, RV]@calleesaves,
										     dst=[],
										     jump=SOME[] }]
									 
    fun procEntryExit3 (frame as {name, formals, size, moves, saves}, body) = if name = mainLabel
									      then { prolog = ".text\n.globl main\nmain:\n"
											      ^ "#PROCEDURE\n" ^ S.name name ^ ":\n"
										              ^ frameStats frame
											      ^ "move $fp, $sp\n"
											      ^ "addi $sp, $sp, -" ^ Int.toString (0 - !size) ^ "\n"
										   , body = body
										   , epilog = "#END " ^ S.name name ^ "\n\n" }
									      else let val fpSave as (InFrame offset) = allocLocal frame true
										   in { prolog = ".text\n.globl " ^ S.name name ^ "\n"
												 ^ "#PROCEDURE\n" ^ S.name name ^ ":\n"
												 ^ frameStats frame
												 ^ "sw $fp, -" ^ Int.toString (0 - offset) ^ "($sp)\n"
												 ^ "move $fp, $sp\n"
												 ^ "addi $sp, $sp, -" ^ Int.toString (0 - !size) ^ "\n"
										      , body=body
										      , epilog = "addi $sp, $sp, " ^ Int.toString (0 - !size) ^ "\n"
												 ^ "lw $fp, -" ^ Int.toString (0 - offset) ^ "($sp)\n"
												 ^ "jr $ra\n"
												 ^ "#END " ^ S.name name ^ "\n\n" }
										   end
									      
    fun string (l, s) =   ".data\n"
			^ ".align 4\n"
			^ (S.name l) ^ ": .asciiz " ^ "\"" ^ (String.toCString s) ^ "\"" ^ "\n"

    datatype frag = PROC of {body : Tree.stm, frame : frame }
		  | STRING of M.label * string

    fun showRegs stream = (app (fn regs => TextIO.output (stream, "#REGS: " ^ U.commaSep (map (fn (r, t) => (r ^ "==" ^ (M.makestring t))) regs) ^ "\n"))
			       [specialregs, argregs, calleesaveregs, callersaveregs, [FPreg]])

    fun showFrame stream frame = TextIO.output (stream, frameStats frame)
end
